home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / os2 / adaptor.zip / ADAPT.ZIP / adaptor / examples / purdue / prob07.fcm < prev    next >
Text File  |  1993-06-26  |  3KB  |  143 lines
  1.       PROGRAM PROB07
  2. C
  3. C     PROBLEM 07
  4. C
  5. C  REFERENCE:  PROBLEMS TO TEST PARALLEL AND VECTOR LANGUAGES
  6. C              CSD-TR 516, COMPUTER SCIENCE, PURDUE UNIVERSITY
  7. C              JOHN R. RICE, MAY 1, 1985
  8. C
  9. C              REVISED BY JOHN R. RICE AND J. JING, OCT. 1, 1990
  10. C
  11. C
  12. C      *************************************************
  13. C      *      Adapted for FORTRAN D benchmarking       *
  14. C      *    by  T. HAUPT  (haupt@sccs.npac.syr.edu)    *
  15. C      *                                               *
  16. C      *    Northeast Parallel Architectures Center    *
  17. C      *   at Syracuse University, Syracuse, NY, USA   *
  18. C      *************************************************
  19. C
  20. C
  21. C       VERSION SEQUENTIAL-1.00  (PLAIN FORTRAN77)
  22. C       ==================================================
  23.       INTEGER KASES,NK,MK
  24.       PARAMETER (KASES=3)
  25.       INTEGER N(KASES),M(KASES)
  26. cmf$  layout N(:SERIAL), M(:SERIAL)
  27.       DATA N /3,5,10/
  28.       DATA M /2048,16384,32768/
  29.       REAL P(4)
  30. cmf$  layout P(:serial)
  31.  
  32.       DO 50 K =  1, KASES
  33.  
  34.       NK=N(K)
  35.       DO 40 I = 1, KASES
  36.  
  37.       call cm_timer_clear (0)
  38.       call cm_timer_start (0)
  39.       DO MANY=1,50
  40.       MK=M(I)
  41.       CALL DOIT(NK,MK,P)
  42.       ENDDO
  43.       call cm_timer_stop (0)
  44.  
  45.       PRINT *,'PROBLEM 7 WITH N,M =',NK,MK
  46.          WRITE (6,*) 'GIVES P(',P(1),')  =',P(2)
  47.          WRITE (6,*) 'AND   P(',P(3),')  =',P(4)
  48.  
  49.       call cm_timer_print (0)
  50.  
  51.    40 CONTINUE
  52.    50 CONTINUE
  53. c     STOP
  54.       END
  55.  
  56.       SUBROUTINE DOIT(NK,MK,P)
  57.       INTEGER NK,MK
  58.       REAL P(4)
  59. cmf$  layout P(:SERIAL)
  60.       REAL DX
  61.       INTEGER I,J,K
  62.       DIMENSION XI(NK),XL(NK), F(NK)
  63. cmf$  layout XI(:SERIAL), XL(:SERIAL), F(:SERIAL)
  64.       DIMENSION TEMP(NK),TAMP(NK),TUMP(NK)
  65. cmf$  layout TEMP(:SERIAL), TAMP(:SERIAL), TUMP(:SERIAL)
  66.       DIMENSION X(MK)
  67.       REAL DENOM(NK)
  68. cmf$  layout DENOM(:SERIAL)
  69.       REAL TP(MK)
  70.  
  71.          DO I = 1, NK
  72.          XI(I)=FLOAT(I-1)
  73.          ENDDO
  74.          call FUN(XI,NK,F)
  75.  
  76.          DX=XI(NK)/MK
  77. !HPF$    INDEPENDENT, LOCAL_ACCESS
  78.          DO K = 1, MK 
  79.             X(K)=0.5+(K-1)*DX
  80.          ENDDO
  81. C
  82. C               DENOMINATOR
  83. C
  84.          DO I = 1, NK
  85.             TEMP(I) = 1.
  86.             DENOM(I) = 1.0
  87.             DO  J = 1, NK
  88.                IF (J.NE.I) THEN
  89.                   TEMP(J) = XI(I)-XI(J)
  90.                   DENOM(I) = DENOM(I)*TEMP(J)
  91.                ENDIF
  92.              ENDDO
  93.  
  94. C
  95. C       NOTE: THE DENOMINATOR IS INVERTED HERE SO THAT A MULTIPLICATION
  96. C               CAN BE DONE LATER
  97. C
  98.             DENOM(I) = 1.0/DENOM(I)
  99.          ENDDO
  100.  
  101. !HPF$    INDEPENDENT, LOCAL_ACCESS
  102.          DO K = 1, MK
  103.             TP(K) = 0.0
  104.             DO  I = 1, NK
  105.                DO J = 1, NK
  106.                   IF (J.NE.I) THEN
  107.                      TAMP(J) = X(K)-XI(J)
  108.                   ENDIF
  109.                ENDDO
  110.                TAMP(I) = 1.0
  111.                PTAMP = 1.0
  112.                DO  J = 1, NK
  113.                   PTAMP = PTAMP*TAMP(J)
  114.               ENDDO
  115.  
  116.                XL(I) = PTAMP*DENOM(I)
  117.             ENDDO
  118.  
  119.             DO I = 1, NK
  120.                TUMP(I) = F(I)*XL(I)
  121.                TP(K) = TP(K)+TUMP(I)
  122.            ENDDO
  123.          ENDDO
  124.  
  125.       P(1)=X(1)
  126.       P(3)=X(MK)
  127.       P(2) = TP(1)
  128.       P(4) = TP(MK)
  129.  
  130. c     RETURN
  131.       END
  132.  
  133.        SUBROUTINE FUN(X,NK,F)
  134.         INTEGER NK
  135.         REAL, ARRAY(NK) :: X,F
  136. cmf$  layout X(:SERIAL)
  137. cmf$  layout F(:SERIAL)
  138.       F = X**2-3.0*X-4.0
  139. c      F=EXP(X)
  140. c     RETURN
  141.       END
  142.  
  143.